home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 4 / BBS in a Box - Macintosh - Volume IV (January 1992) (BBS in a Box).iso / Files / Prog / M / MARQUEE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-05-27  |  3.0 KB  |  86 lines  |  [TEXT/MACA]
  1. { Demo program for "marching ants" marquee - John Jeppson }
  2.  
  3. {$R-}                               { Turn off range checking }
  4. PROGRAM test;
  5.  
  6. USES
  7.     Memtypes, Quickdraw, OSIntf, ToolIntf, PackIntf,
  8.     CursorCtl,                      { for the spinning cursor }
  9.     Signal,                         { to handle command-period }
  10.     PasLibIntf,                     { for standard I/O, etc. }
  11.     IntEnv;                         { for argV and argC }
  12.     
  13. VAR
  14.     window:         WindowPtr;
  15.     theRect:        Rect;
  16.     marqueePattern: Pattern;
  17.     theTicks:       LONGINT;
  18.  
  19. PROCEDURE initMarquee;
  20.     BEGIN
  21.         StuffHex( @marqueePattern, 'F8F1E3C78F1F3E7C' );
  22.     END;
  23.  
  24. PROCEDURE rotateByte( p: Ptr );
  25.     INLINE $205F, $1010, $E218, $1080;
  26.     {
  27.         move.l  (sp)+,a0
  28.         move.b  (a0),d0
  29.         ror.b   #1,d0
  30.         move.b  d0,(a0)
  31.     }
  32.  
  33. PROCEDURE rotatePattern( VAR thePat: Pattern ); 
  34.     VAR
  35.         i:  INTEGER;
  36.     BEGIN
  37.         FOR i := 0 TO 7 DO
  38.             rotateByte( @thePat[i] );
  39.     END;
  40.  
  41. PROCEDURE drawNextMarquee( r: Rect );
  42.     BEGIN
  43.         IF theTicks <> Tickcount THEN
  44.         BEGIN
  45.             theTicks := Tickcount;
  46.             rotatePattern( marqueePattern );
  47.             PenPat( marqueePattern );
  48.             FrameRect( r );
  49.         END;
  50.     END;
  51.  
  52. PROCEDURE makeWindow;
  53.     VAR
  54.         windowBounds: Rect;
  55.     BEGIN
  56.         SetRect( windowBounds, 50, 50, 300, 220 );
  57.         window := NewWindow( NIL, windowBounds, 'Marquee', TRUE,
  58.                         documentProc, Pointer(-1), FALSE, 0 );
  59.         SetPort( window );
  60.         InitCursor;
  61.         MoveTo( 47, 130 );
  62.         DrawString( '-- click mouse to quit --' );
  63.     END;
  64.  
  65. FUNCTION haveEvent : Boolean;
  66.     VAR
  67.         thisEvent: EventRecord;
  68.     BEGIN
  69.         haveEvent := GetNextEvent( mDownMask, thisEvent );
  70.     END;
  71.  
  72. BEGIN
  73.     InitGraf(@thePort);
  74.     SetFScaleDisable(true);
  75.  
  76.     makeWindow;
  77.     initMarquee;
  78.     
  79.     SetRect( theRect, 50, 30, 200, 100 );
  80.  
  81.     WHILE NOT haveEvent DO
  82.         drawNextMarquee( theRect );
  83.  
  84.     DisposeWindow( window );
  85. END.